COMMENT ⊗   VALID 00003 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	.REQUIRE "LSPMAC.PUB[LSP,CLT]" source_file
C00003 00003	.hd206 SPRING 1978
C00010 ENDMK
C⊗;
.REQUIRE "LSPMAC.PUB[LSP,CLT]" source_file;
.
.MACRO  hd206 (TERM) ⊂
.BEGIN    NOFILL  TURNON "←→"
.place heading
←COMPUTER SCIENCE DEPARTMENT
←STANFORD UNIVERSITY
.place text
CS206  ←COMPUTING WITH SYMBOLIC EXPRESSIONS  →TERM
.TURNOFF
.END ⊃
.LSPFONT
.FONT A "FIX25";
.basicops 
.itemmac 1;
.
.PORTION MAINPORTION
.hd206 SPRING 1978
.PAGE ← 1
.cb |Functions definitions (external and internal form) for assignment 1.|
.item ← 0

#. ⊗allsub[u,v]  
.begin  nofill select 2 

⊗⊗        allsub[u, v] ← allsub1[u, v, 1]⊗

⊗⊗        allsub1[u, v, n] ← ⊗
⊗⊗            qif qn v qthen qNIL⊗
⊗⊗            qelse qif match[u, v] qthen n . allsub1[u, qd v, add1 n]⊗
⊗⊗            qelse allsub1[u, qd v, add1 n]⊗

⊗⊗        match[u, v] ← ⊗
⊗⊗            qif qn u qthen qT qelse qif qn v qthen qNIL qelse qa u = qa v ∧ match[qd u, qd v]⊗
.end

.begin nofill select A 

	(DEFUN ALLSUB (U V) (ALLSUB1 U V 1.)) 

	(DEFUN ALLSUB1 (U V N) 
	       (COND ((NULL V) NIL)
		     ((MATCH U V) (CONS N (ALLSUB1 U (CDR V) (ADD1 N))))
		     (T (ALLSUB1 U (CDR V) (ADD1 N))))) 

	(DEFUN MATCH (U V) 
	       (COND ((NULL U) T)
		     ((NULL V) NIL)
		     (T (AND (EQUAL (CAR U) (CAR V))
			     (MATCH (CDR U) (CDR V)))))) 
.end

#. ⊗allsub![u,v] 

.begin nofill select 2

⊗⊗        allsub![u, v] ← allsub!1[u, v, 1]⊗

⊗⊗        allsub!1[u, v, n] ← ⊗
⊗⊗            qif qn v qthen qNIL⊗
⊗⊗            qelse qif match[u, v] qthen <n> . allsub!1[u, qd v, add1 n]⊗
⊗⊗            qelse qif qat qa v qthen allsub!1[u, qd v, add1 n]⊗
⊗⊗            qelse tack[n, allsub![u, qa v]] * allsub!1[u, qd v, add1 n]⊗

⊗⊗        tack[n, w] ← qif qn w qthen qNIL qelse [n . qa w] . tack[n, qd w]⊗
.end

.begin nofill select A

	(DEFUN ALLSUB! (U V) (ALLSUB!1 U V 1.)) 

	(DEFUN ALLSUB!1 (U V N) 
	       (COND ((NULL V) NIL)
		     ((MATCH U V)
		      (CONS (LIST N) (ALLSUB!1 U (CDR V) (ADD1 N))))
		     ((ATOM (CAR V)) (ALLSUB!1 U (CDR V) (ADD1 N)))
		     (T (APPEND (TACK N (ALLSUB! U (CAR V)))
				(ALLSUB!1 U (CDR V) (ADD1 N)))))) 

	(DEFUN TACK (N W) 
	       (COND ((NULL W) NIL)
		     (T (CONS (CONS N (CAR W)) (TACK N (CDR W)))))) 
.end

#.  ⊗mapexp [or ⊗⊗maptree⊗]

.begin nofill select 2

⊗⊗        maptree[s, f1, f2] ← ⊗
⊗⊗            qif qat s qthen f1 s⊗
⊗⊗            qelse f2[maptree[qa s, f1, f2], maptree[qd s, f1, f2]]⊗
.end
.begin nofill select A

	(DEFUN MAPTREE (S F1 F2) 
	       (COND ((ATOM S) (F1 S))
		     (T (F2 (MAPTREE (CAR S) F1 F2)
			    (MAPTREE (CDR S) F1 F2))))) 
.end

#. ⊗ncomps 
.begin nofill select 2

⊗⊗        ncomps g ← qif qn g qthen 0 qelse add1 ncomps scan[qd g, qNIL, qa g, qNIL]⊗

⊗⊗        scan[g, h, u, flag] ← ⊗
⊗⊗            qif qn g qthen [qif qn flag ∨ qn h qthen h qelse scan[h, qNIL, u, qNIL]]⊗
⊗⊗            qelse qif qn [qaa g ε u] qthen scan[qd g, qa g . h, u, flag]⊗
⊗⊗            qelse scan[qd g, h, u * qa g, qT]⊗
.end


.begin nofill select A

(DEFUN NCOMPS (G) 
       (COND ((NULL G) 0.)
	     (T (ADD1 (NCOMPS (SCAN (CDR G) NIL (CAR G) NIL)))))) 

(DEFUN SCAN (G H U FLAG) 
       (COND ((NULL G)
	      (COND ((OR (NULL FLAG) (NULL H)) H)
		    (T (SCAN H NIL U NIL))))
	     ((NULL (MEMBER (CAAR G) U))
	      (SCAN (CDR G) (CONS (CAR G) H) U FLAG))
	     (T (SCAN (CDR G) H (APPEND U (CAR G)) T)))) 	       
.end

#. ⊗partition[u,n] 
.begin nofill select 2

⊗⊗        partition[u, n] ← ⊗
⊗⊗            qif length u < n qthen $$(INVALID N)$ qelse part1[<qa u>, qd u, sub1 n]⊗

⊗⊗        part1[u, v, n] ← ⊗
⊗⊗            qif qn v qthen [qif zerop n qthen <<u>> qelse qNIL]⊗
⊗⊗            qelse tack[u, part1[<qa v>, qd v, sub1 n]]⊗
⊗⊗                  * part1[u * <qa v>, qd v, n]⊗

⊗⊗        testpart[v, u] ← ⊗
⊗⊗            qif qn v qthen qT⊗
⊗⊗            qelse combine qa v = u ∧ testpart[qd v, u] ⊗

⊗⊗        combine w ← qif qn w qthen qNIL qelse qa w * combine qd w⊗
.end

.begin nofill select A

	(DEFUN PARTITION (U N) 
	       (COND ((LESSP (LENGTH U) N) '(INVALID N))
		     (T (PART1 (LIST (CAR U)) (CDR U) (SUB1 N))))) 

	(DEFUN PART1 (U V N) 
	       (COND ((NULL V) (COND ((ZEROP N) (LIST (LIST U))) (T NIL)))
		     (T (APPEND (TACK U
				      (PART1 (LIST (CAR V)) (CDR V) (SUB1 N)))
				(PART1 (APPEND U (LIST (CAR V)))
				       (CDR V)
				       N))))) 

	(DEFUN LINK (U W) 
	       (COND ((NULL W) NIL)
		     (T (CONS (CONS U (CAR W)) (LINK U (CDR W)))))) 

	(DEFUN TESTPART (V U) 
	       (COND ((NULL V) T)
		     ((AND (EQUAL (COMBINE (CAR V)) U)
			   (TESTPART (CDR V) U))))) 

	(DEFUN COMBINE (W) 
	       (COND ((NULL W) NIL) (T (APPEND (CAR W) (COMBINE (CDR W)))))) 
.end